--# -path=.:prelude:alltenses

 concrete SyllogismEng of Syllogism = LexiconSyllEng ** open Prelude, StringOper, ResEng in { 
 

 param WClass = IsNoun | IsVerb | IsAdj | IsPhrase;
 param PClass = Single | Disjunct | Conjunct;
 param Formality = Formal | Informal;
  
 
     lincat 
         Syllogism = {s : Str }; 
         Sentence  = { s : Str}; 
         Subject   = {s : Number => Str };
         Conclusion = {s : Str}; 
         Property  = {s : Formality => Number => Polarity => Str; c : PClass};
         PropertyPart = {s : Either => Formality => Number => Polarity =>  Str;
                         c : WClass; lock_PropertyPart : {} }; 
         Word = {sub : Number => Str;
                 prop : Either => Formality => Number => Polarity => Str;
                 c : WClass  };
                         
         Sentences = {s : Str};    
         Constant  = {s : Str}; 
         Const     = {s : Str};
         AllQ      = {s : Str; n : Number};
         NoQ       = {s : Str};

     lin
        AWord a = {sub = (adjToSub  a).s; prop = (adjToProp a).s; c = IsAdj};
        NWord n = {sub = (nounToSub n).s; prop = (nounToProp n).s; c = IsNoun};
        VWord v = {sub = (verbToSub v).s; prop = (verbToProp v).s; c = IsVerb};
        CWord c = {s = c.s ! Nom};
            

        SPhrase a n = {s = (nphrToSub a n).s}; 
        PPhrase a n = {s = (nphrToProp a n).s; c = Single};

       CpP const prop = let f = Informal | Formal in
                  {s = const.s ++ prop.s ! f ! Sg ! Pos};
       CnP const prop = let f = Informal | Formal in
                  {s = const.s ++ prop.s ! f ! Sg ! Neg};
       SaP allq sub prop =  let f = Informal | Formal in
                  {s = allq.s ++ sub.s ! allq.n ++ 
                                         prop.s ! f ! allq.n !Pos} ; 
       SoP sub prop =  let f = Informal | Formal in
                  {s = "Some" ++ sub.s ! Pl ++ 
                                         prop.s ! f !Pl !Neg} ;      
       SeP _ sub prop =  let f = Informal | Formal;
                             q = sepq prop in
                  {s = q.s ++ sub.s ! q.n ++ 
                                         prop.s ! f ! q.n ! q.p} ; 
       SiP sub prop =  let f = Informal | Formal in
                  {s = "Some" ++ sub.s ! Pl ++ 
                                          prop.s ! f !Pl !Pos} ;  
       ToProperty sWord = mkProp sWord ** {c = Single};  
       ToSubject  sWord  = {s = sWord.sub}; 
       ToConstant const = const;
       ToPropertyPart word = {s = word.prop; c = word.c} 
                                   ** {lock_PropertyPart = <>}; 
    
       ToConclusion sent = sent | {s = isItTrue ++ sent.s};


       mkSyllogism ps c = {s = "(" ++ ps.s ++ ") ->" ++ c.s};
       mkSentences s1 s2  = {s = s1.s ++ "+" ++ s2.s};
       appSentences s1 ss = {s = s1.s ++ "+" ++ ss.s};  

       And p1 p2 = {s = \\f,num,pol => propAnd p1 p2 num pol f;
                    c = Conjunct} ; 
       Or  p1 p2 = {s = \\f,num,pol => propOr p1 p2 num pol f;
                    c = Disjunct};  
       
       All   = {s = "All"; n = Pl};
       Every = {s = "Every"; n = Sg};
       No  = {s = "No"};
       


  ------------------------------- OPERATIONS ----------------------------------
  
{-
   The parameter Either works like a placeholder in a property which tells
   where to insert either/neither/both/not.
   NorS is for the second part of a dis/conjunction and gives the phrase 
   whithout "is" or "does" (eg. "a laptop").
   NoneS is for phrases without any of these words. 
 -}
 
  param Either  = NotS | NeitherS | EitherS | NorS | NoneS | BothS;

 oper
  notStr : Either -> Str =
   \not -> case not of {
     NotS =>  "not"; --pre {"not" ; "&+ n't" / strs {"does"}};
     NeitherS => "neither";
     EitherS => "either";
     NorS    => "";
     BothS   => "both";
     NoneS   => ""};  
  
  isItTrue : Str = "is it true that";

  -- creates a Property from a PropertyPart
  mkProp : {s : Either => Formality => Number => Polarity => Str} ->
                 {s : Formality => Number => Polarity => Str} = \w ->
     {s = \\f,n => table {Neg => w.s ! NotS ! f ! n ! Neg;
                          _    => w.s ! NoneS ! f !n ! Pos}};

  -- operations for creating Words out of adjectives, nouns and verbs
  adjToProp : A -> { s : Either => Formality => Number => Polarity => Str}
         =  \wor ->  let adj = wor.s ! AAdj Posit Nom in 
       {   s  = table {NorS => \\_,n,p  => adj;
                       not  => \\f,n ,p => 
                                       (notVariant (be.s ! n) not f) ++ adj}};
     
  adjToSub : A -> {s : Number => Str} = \wor -> 
        let adj = wor.s ! AAdj Posit Nom in
         { s = table {Sg => "one who is" ++ adj  ; 
                      Pl => "who are" ++ adj} 
         };

  nounToSub : N -> {s : Number => Str } = \wor -> 
            { s = table {Sg => wor.s ! Sg ! Nom; 
                         Pl => wor.s ! Pl ! Nom } 
            }; 
     
     
  nounToProp : N -> { s : Either => Formality => Number => Polarity => Str}
   = \wor -> 
   {s = table{
      NorS => \\_ => table
         {Sg => \\_ => artIndef ++  wor.s ! Sg ! Nom;
          Pl => \\_ => wor.s ! Pl ! Nom};
      not => \\f => table
         {Sg => \\_ => (notVariant "is" not f) ++ artIndef ++ wor.s ! Sg ! Nom;
          Pl => \\_ => (notVariant "are" not f) ++ wor.s ! Pl ! Nom}
       }};        
     

  verbToSub :  V -> {s: Number => Str} = \wor -> 
         { s = table {Sg => "one who" ++ wor.s ! VPres;  
                      Pl => "who" ++ wor.s ! VInf} 
         }; 
     
  verbToProp : V -> { s : Either => Formality => Number => Polarity => Str}
        = \wor ->  
         { s = table{
            NorS => \\_ => table
                  {Sg => table {Neg => wor.s ! VInf ; 
                                _    => wor.s ! VPres}; 
                   Pl => \\_ => wor.s ! VInf};   
            not => \\f => table
               {Sg => table {Neg => (notVariant "does" not f) ++ wor.s ! VInf ;
                             _    => notStr not ++ wor.s ! VPres};
                Pl => table {Neg => (notVariant "do" not f) ++ wor.s ! VInf;
                             _    => notStr not ++ wor.s ! VInf} 
                      }
         }} ;        

 
  -- operations for creating Words out of phrases like 'a blue flower'
  nphrToSub : A -> N -> {s : Number => Str} = \a, n ->
    {s =  \\num => a.s !  AAdj Posit Nom  ++ n.s ! num ! Nom};

  nphrToProp : A -> N -> {s : Formality => Number => Polarity => Str}
    = \a, n ->
    let adj = a.s ! AAdj Posit Nom in
   {s = \\f => table{
       Sg => table{Neg => (notVariant "is" NotS f) ++ artIndef ++ adj 
                                                 ++ n.s ! Sg ! Nom;
                   _    => "is" ++ artIndef ++ adj ++ n.s ! Sg ! Nom};
       Pl => table{Neg => (notVariant "are" NotS f)  ++ adj 
                                                 ++ n.s ! Pl ! Nom;
                   _    => "are" ++ adj ++ n.s ! Pl ! Nom}}};

  -- operations for conjuctions 
  -- would be nice if the two words could have different formality,
  -- but gf does not like.
  propAnd : PropertyPart -> PropertyPart -> Number -> Polarity 
                                                  -> Formality -> Str
      = \word1, word2, num, pol,f ->
      let begin = (word1.s ! polarityW1 pol ! f ! num ! pol ++ "and") in
         case sameClass word1.c word2.c of {
           True  => begin ++ word2.s ! polarityW2 pol True  ! f ! num ! pol ;
           False => begin ++ word2.s ! polarityW2 pol False ! f ! num ! pol
         };

  be : {s : Number => Str} =
    {s = table {Sg => "is"; Pl => "are"}};

  oper polarityW1 : Polarity -> Either = 
     \pol -> case pol of{
          Neg => NotS;
          _    => BothS};

  polarityW2 : Polarity -> Bool -> Either = 
     \pol, b -> case pol of{
          Neg => NotS;
          _    => case b of { True =>  NorS; False => NoneS}};

  -- operations for disjuction 
  propOr : PropertyPart -> PropertyPart -> Number -> Polarity -> Formality -> Str
      = \word1, word2, num, pol,f ->
     case pol of {
         Pos => combineDisj word1 word2 num Pos f EitherS "or";
         _    => combineDisj word1 word2 num Pos f NeitherS "nor"
      };
 

  combineDisj : PropertyPart -> PropertyPart -> Number ->
                  Polarity -> Formality -> Either -> Str -> Str
   = \word1, word2, num, pol, f, not, or -> 
     let begin = word1.s ! not ! f ! num ! pol ++ or  in
    case sameClass word1.c word2.c of{
      True => begin ++ word2.s ! NorS ! f ! num ! pol;
      False => begin ++ word2.s ! NoneS ! f ! num ! pol
  }; 

-- for seeing how two words can be combined
  sameClass : WClass -> WClass -> Bool =
   \c1, c2 -> case c1 of{
     IsVerb => case c2 of{ IsVerb => True;
                           _       => False};
      _     => case c2 of{ IsVerb => False;
                            _      => True}};

  notVariant : Str -> Either -> Formality -> Str =
   \do, not,f -> case f of{
     Formal  => do ++ notStr not;
     Informal =>case not of{
       NotS   => do + "n't";
       either => do ++ notStr either}
   };

 -- the commented part could be added if variants are handled in another way
  sepq  : Property -> {s : Str; n : Number; p : Polarity}  =
   \p -> case p.c of{Disjunct => --{s ="Every"; n = Sg; p = Neg} | 
                                   {s = "All"; n = Pl; p = Neg};
                     _ => {s = "No"; n = Sg ; p = Pos}}; 
}
